home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / ActiveX_Co1799029302004.psc / ActiveX Coder 4 / Forms / frmMain.frm next >
Text File  |  2004-10-01  |  32KB  |  1,153 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  5. Begin VB.Form frmMain 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "ActiveX Coder 4"
  8.    ClientHeight    =   7725
  9.    ClientLeft      =   150
  10.    ClientTop       =   840
  11.    ClientWidth     =   8880
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   7725
  16.    ScaleWidth      =   8880
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin ComctlLib.ListView lstmain 
  19.       Height          =   3135
  20.       Left            =   0
  21.       TabIndex        =   6
  22.       Top             =   2040
  23.       Width           =   8895
  24.       _ExtentX        =   15690
  25.       _ExtentY        =   5530
  26.       View            =   3
  27.       LabelEdit       =   1
  28.       LabelWrap       =   0   'False
  29.       HideSelection   =   0   'False
  30.       OLEDropMode     =   1
  31.       _Version        =   327682
  32.       SmallIcons      =   "imglst1"
  33.       ForeColor       =   -2147483640
  34.       BackColor       =   -2147483643
  35.       Appearance      =   0
  36.       OLEDropMode     =   1
  37.       NumItems        =   0
  38.    End
  39.    Begin VB.CommandButton Command4 
  40.       Caption         =   "Remove All"
  41.       Enabled         =   0   'False
  42.       Height          =   255
  43.       Left            =   3480
  44.       TabIndex        =   17
  45.       Top             =   120
  46.       Width           =   1575
  47.    End
  48.    Begin VB.CommandButton Command3 
  49.       Caption         =   "Invert Selection"
  50.       Height          =   255
  51.       Left            =   3480
  52.       TabIndex        =   16
  53.       Top             =   1680
  54.       Width           =   1575
  55.    End
  56.    Begin VB.CommandButton Command2 
  57.       Caption         =   "UnSelect All"
  58.       Height          =   255
  59.       Left            =   1800
  60.       TabIndex        =   15
  61.       Top             =   1680
  62.       Width           =   1575
  63.    End
  64.    Begin VB.CommandButton Command1 
  65.       Caption         =   "Select All"
  66.       Height          =   255
  67.       Left            =   120
  68.       TabIndex        =   14
  69.       Top             =   1680
  70.       Width           =   1575
  71.    End
  72.    Begin VB.ComboBox Combo1 
  73.       Height          =   315
  74.       ItemData        =   "frmMain.frx":0000
  75.       Left            =   4680
  76.       List            =   "frmMain.frx":0002
  77.       TabIndex        =   1
  78.       Top             =   720
  79.       Width           =   4095
  80.    End
  81.    Begin VB.CommandButton cmdmain 
  82.       Caption         =   "Generate && Copy"
  83.       Enabled         =   0   'False
  84.       BeginProperty Font 
  85.          Name            =   "Verdana"
  86.          Size            =   8.25
  87.          Charset         =   0
  88.          Weight          =   400
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       Height          =   255
  94.       Index           =   5
  95.       Left            =   6840
  96.       TabIndex        =   7
  97.       ToolTipText     =   "Copy generated code"
  98.       Top             =   1680
  99.       Width           =   1935
  100.    End
  101.    Begin VB.TextBox txtmain 
  102.       Height          =   285
  103.       Index           =   0
  104.       Left            =   135
  105.       TabIndex        =   0
  106.       Top             =   720
  107.       Width           =   4200
  108.    End
  109.    Begin VB.TextBox txtmain 
  110.       Height          =   285
  111.       Index           =   3
  112.       Left            =   4680
  113.       TabIndex        =   3
  114.       Top             =   1320
  115.       Width           =   4080
  116.    End
  117.    Begin VB.TextBox txtmain 
  118.       Height          =   285
  119.       Index           =   2
  120.       Left            =   135
  121.       TabIndex        =   2
  122.       Top             =   1320
  123.       Width           =   4200
  124.    End
  125.    Begin VB.CommandButton cmdmain 
  126.       Caption         =   "Add"
  127.       Height          =   255
  128.       Index           =   0
  129.       Left            =   135
  130.       TabIndex        =   4
  131.       ToolTipText     =   "Add values"
  132.       Top             =   120
  133.       Width           =   1560
  134.    End
  135.    Begin VB.CommandButton cmdmain 
  136.       Caption         =   "Remove Selected"
  137.       Enabled         =   0   'False
  138.       Height          =   255
  139.       Index           =   1
  140.       Left            =   1800
  141.       TabIndex        =   5
  142.       ToolTipText     =   "Remove selected entrie"
  143.       Top             =   120
  144.       Width           =   1575
  145.    End
  146.    Begin MSComDlg.CommonDialog CDL1 
  147.       Left            =   7440
  148.       Top             =   0
  149.       _ExtentX        =   847
  150.       _ExtentY        =   847
  151.       _Version        =   393216
  152.    End
  153.    Begin RichTextLib.RichTextBox Rich 
  154.       Height          =   2535
  155.       Left            =   0
  156.       TabIndex        =   13
  157.       Top             =   5175
  158.       Width           =   8865
  159.       _ExtentX        =   15637
  160.       _ExtentY        =   4471
  161.       _Version        =   393217
  162.       BorderStyle     =   0
  163.       ScrollBars      =   2
  164.       DisableNoScroll =   -1  'True
  165.       Appearance      =   0
  166.       AutoVerbMenu    =   -1  'True
  167.       TextRTF         =   $"frmMain.frx":0004
  168.    End
  169.    Begin VB.Label lbllstcount 
  170.       Alignment       =   1  'Right Justify
  171.       BackStyle       =   0  'Transparent
  172.       Height          =   255
  173.       Left            =   5160
  174.       TabIndex        =   12
  175.       Top             =   120
  176.       Width           =   3615
  177.    End
  178.    Begin VB.Label Label1 
  179.       BackStyle       =   0  'Transparent
  180.       Caption         =   "Property name:"
  181.       BeginProperty Font 
  182.          Name            =   "Verdana"
  183.          Size            =   6.75
  184.          Charset         =   0
  185.          Weight          =   400
  186.          Underline       =   0   'False
  187.          Italic          =   0   'False
  188.          Strikethrough   =   0   'False
  189.       EndProperty
  190.       Height          =   255
  191.       Index           =   0
  192.       Left            =   135
  193.       TabIndex        =   11
  194.       Top             =   480
  195.       Width           =   2655
  196.    End
  197.    Begin VB.Label Label1 
  198.       BackStyle       =   0  'Transparent
  199.       Caption         =   "Type of variable:"
  200.       BeginProperty Font 
  201.          Name            =   "Verdana"
  202.          Size            =   6.75
  203.          Charset         =   0
  204.          Weight          =   400
  205.          Underline       =   0   'False
  206.          Italic          =   0   'False
  207.          Strikethrough   =   0   'False
  208.       EndProperty
  209.       Height          =   255
  210.       Index           =   1
  211.       Left            =   4680
  212.       TabIndex        =   10
  213.       Top             =   480
  214.       Width           =   2655
  215.    End
  216.    Begin VB.Label Label1 
  217.       BackStyle       =   0  'Transparent
  218.       Caption         =   "Container variable:"
  219.       BeginProperty Font 
  220.          Name            =   "Verdana"
  221.          Size            =   6.75
  222.          Charset         =   0
  223.          Weight          =   400
  224.          Underline       =   0   'False
  225.          Italic          =   0   'False
  226.          Strikethrough   =   0   'False
  227.       EndProperty
  228.       Height          =   255
  229.       Index           =   2
  230.       Left            =   135
  231.       TabIndex        =   9
  232.       Top             =   1080
  233.       Width           =   2655
  234.    End
  235.    Begin VB.Label Label1 
  236.       BackStyle       =   0  'Transparent
  237.       Caption         =   "Default:"
  238.       BeginProperty Font 
  239.          Name            =   "Verdana"
  240.          Size            =   6.75
  241.          Charset         =   0
  242.          Weight          =   400
  243.          Underline       =   0   'False
  244.          Italic          =   0   'False
  245.          Strikethrough   =   0   'False
  246.       EndProperty
  247.       Height          =   255
  248.       Index           =   3
  249.       Left            =   4695
  250.       TabIndex        =   8
  251.       Top             =   1080
  252.       Width           =   2655
  253.    End
  254.    Begin ComctlLib.ImageList imgSmall 
  255.       Left            =   8040
  256.       Top             =   0
  257.       _ExtentX        =   1005
  258.       _ExtentY        =   1005
  259.       BackColor       =   -2147483643
  260.       ImageWidth      =   16
  261.       ImageHeight     =   16
  262.       MaskColor       =   12632256
  263.       _Version        =   327682
  264.       BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
  265.          NumListImages   =   4
  266.          BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  267.             Picture         =   "frmMain.frx":0086
  268.             Key             =   ""
  269.          EndProperty
  270.          BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  271.             Picture         =   "frmMain.frx":05D8
  272.             Key             =   ""
  273.          EndProperty
  274.          BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  275.             Picture         =   "frmMain.frx":0B2A
  276.             Key             =   ""
  277.          EndProperty
  278.          BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  279.             Picture         =   "frmMain.frx":0E7C
  280.             Key             =   ""
  281.          EndProperty
  282.       EndProperty
  283.    End
  284.    Begin VB.Menu mnuFile 
  285.       Caption         =   "File"
  286.       Begin VB.Menu mnuFileNew 
  287.          Caption         =   "&New..."
  288.          Shortcut        =   ^N
  289.       End
  290.       Begin VB.Menu mnuFileLoad 
  291.          Caption         =   "&Open..."
  292.          Shortcut        =   ^O
  293.       End
  294.       Begin VB.Menu mnuFileSep2 
  295.          Caption         =   "-"
  296.       End
  297.       Begin VB.Menu mnuFileS 
  298.          Caption         =   "&Save"
  299.          Enabled         =   0   'False
  300.          Shortcut        =   ^S
  301.       End
  302.       Begin VB.Menu mnuFileSS 
  303.          Caption         =   "Save &As..."
  304.       End
  305.       Begin VB.Menu mnuFileSep3 
  306.          Caption         =   "-"
  307.       End
  308.       Begin VB.Menu mnuFileImp 
  309.          Caption         =   "Import..."
  310.          Shortcut        =   ^I
  311.       End
  312.       Begin VB.Menu mnusep1 
  313.          Caption         =   "-"
  314.       End
  315.       Begin VB.Menu mnuFileExit 
  316.          Caption         =   "E&xit"
  317.       End
  318.    End
  319.    Begin VB.Menu mnuEdit 
  320.       Caption         =   "Edit"
  321.       Begin VB.Menu mnuEditCopy 
  322.          Caption         =   "Co&py"
  323.          Enabled         =   0   'False
  324.          Shortcut        =   ^C
  325.       End
  326.       Begin VB.Menu mnusep2 
  327.          Caption         =   "-"
  328.       End
  329.       Begin VB.Menu mnuEditAdd 
  330.          Caption         =   "A&dd"
  331.          Shortcut        =   +{INSERT}
  332.       End
  333.       Begin VB.Menu mnuEditRemove 
  334.          Caption         =   "Re&move Selected"
  335.          Enabled         =   0   'False
  336.          Shortcut        =   {DEL}
  337.       End
  338.       Begin VB.Menu mnusep3 
  339.          Caption         =   "-"
  340.       End
  341.       Begin VB.Menu mnuEditRemoveAll 
  342.          Caption         =   "Remove &All..."
  343.          Enabled         =   0   'False
  344.          Shortcut        =   +{DEL}
  345.       End
  346.       Begin VB.Menu mnusep4 
  347.          Caption         =   "-"
  348.       End
  349.       Begin VB.Menu mnuEditGen 
  350.          Caption         =   "Generate &Code"
  351.          Enabled         =   0   'False
  352.          Shortcut        =   ^G
  353.       End
  354.    End
  355.    Begin VB.Menu mnuHelp 
  356.       Caption         =   "Help"
  357.       Begin VB.Menu mnuHelpAbout 
  358.          Caption         =   "&About..."
  359.          Shortcut        =   {F1}
  360.       End
  361.    End
  362.    Begin VB.Menu mnuLstMain 
  363.       Caption         =   "lstmain"
  364.       Visible         =   0   'False
  365.       Begin VB.Menu mnuLstMainEdit 
  366.          Caption         =   "&Edit"
  367.       End
  368.       Begin VB.Menu mnuLstMainSep1 
  369.          Caption         =   "-"
  370.       End
  371.       Begin VB.Menu mnuLstMainRR 
  372.          Caption         =   "Remove Selected"
  373.       End
  374.       Begin VB.Menu mnuLstMainDelR 
  375.          Caption         =   "Remove &All..."
  376.       End
  377.    End
  378. End
  379. Attribute VB_Name = "frmMain"
  380. Attribute VB_GlobalNameSpace = False
  381. Attribute VB_Creatable = False
  382. Attribute VB_PredeclaredId = True
  383. Attribute VB_Exposed = False
  384. Option Explicit
  385. Private tHt As LVHITTESTINFO
  386. Private list_item As ListItem
  387. Private X As New clsList
  388. Private i As Integer
  389. Private DocChanged As Boolean
  390. Private docname As String
  391. Private xx As Integer
  392.  
  393. Const LVM_FIRST = &H1000&
  394. Const LVM_HITTEST = LVM_FIRST + 18
  395.  
  396. Private Type POINTAPI
  397.     X As Long
  398.     Y As Long
  399. End Type
  400.  
  401. Private Type LVHITTESTINFO
  402.    pt As POINTAPI
  403.    flags As Long
  404.    iItem As Long
  405.    iSubItem As Long
  406. End Type
  407.  
  408. Dim TT As CTooltip
  409. Dim m_lCurItemIndex As Long
  410.  
  411. Private Sub ClearTxt()
  412. txtmain(0).Text = ""
  413. Combo1.Text = ""
  414. txtmain(2).Text = ""
  415. txtmain(3).Text = ""
  416. Rich.Text = ""
  417. Rich.Text = ""
  418.  
  419. End Sub
  420.  
  421.  
  422. Private Sub cmdmain_Click(index As Integer)
  423. On Error Resume Next
  424. Select Case index
  425.     Case 0 'Add
  426.  
  427.     Set list_item = lstmain.ListItems.Add(, , lstmain.ListItems.Count + 1)
  428.     list_item.SmallIcon = SetListIcon(Combo1)
  429.     list_item.SubItems(1) = txtmain(0)
  430.     list_item.SubItems(2) = Combo1
  431.     list_item.SubItems(3) = txtmain(2)
  432.     list_item.SubItems(4) = txtmain(3)
  433.     
  434.     DocChanged = True
  435.         listcount
  436.         checklst
  437.         txtmain(0) = Empty
  438.         Combo1 = Empty
  439.         txtmain(2) = Empty
  440.         txtmain(3) = Empty
  441.         Rich.Text = Empty
  442.     
  443.     Case 1 'Remove
  444.     Dim i As Integer
  445.     Dim srtx As String
  446.     Do
  447.     For i = 0 To FindLVCHKED - 1
  448.     srtx = Get_After_Comma(i, countComa)
  449.             lstmain.ListItems.Remove lstmain.ListItems.Item(srtx + 1).index
  450.         listcount
  451.         checklst
  452.         Rich.Text = Empty
  453.     Next i
  454.     Loop Until FindLVCHKED <= 0
  455.         
  456.     Case 2 'Generate
  457.     If FindLVCHKED <= 0 Then Exit Sub
  458.     Dim xitem As Integer
  459.         Rich.Text = Empty
  460.         Rich.Text = Rich.Text & "Option Explicit" & vbNewLine & vbNewLine
  461.         'Generate Private Decleractions
  462.     For i = 0 To FindLVCHKED - 1
  463.     xitem = Get_After_Comma(i, countComa)
  464.             With lstmain.ListItems.Item(xitem + 1)
  465.                 Rich.Text = Rich.Text & "Private " & .SubItems(3) & " As " & .SubItems(2) & vbNewLine
  466.             End With
  467.         Next
  468.         Rich.Text = Rich.Text & vbNewLine
  469.         'Generate Get, Let properties
  470.         For i = 0 To FindLVCHKED - 1
  471.         xitem = Get_After_Comma(i, countComa)
  472.             With lstmain.ListItems.Item(xitem + 1)
  473.                 Rich.Text = Rich.Text & generate(.SubItems(1), .SubItems(2), .SubItems(3)) & vbNewLine & vbNewLine
  474.             End With
  475.         Next
  476.         'Generate UserControl_ReadProperties
  477.         Rich.Text = Rich.Text & vbNewLine & "Private Sub UserControl_ReadProperties(PropBag As PropertyBag)" & vbNewLine
  478.         For i = 0 To FindLVCHKED - 1
  479.         xitem = Get_After_Comma(i, countComa)
  480.             With lstmain.ListItems.Item(xitem + 1)
  481.                 If .SubItems(2) = "String" Then .SubItems(4) = """" & .SubItems(4) & """"
  482.                 Rich.Text = Rich.Text & vbTab & .SubItems(1) & " = PropBag.ReadProperty(" & """" & .SubItems(1) & """" & ", " & .SubItems(4) & ")" & vbNewLine
  483.                 .SubItems(4) = Replace(.SubItems(4), """", "")
  484.             End With
  485.         Next
  486.         'Generate UserControl_WriteProperties
  487.         Rich.Text = Rich.Text & "End Sub" & vbNewLine & vbNewLine & "Private Sub UserControl_WriteProperties(PropBag As PropertyBag)" & vbNewLine
  488.         Rich.Text = Rich.Text & "   With PropBag" & vbNewLine
  489.         For i = 0 To FindLVCHKED - 1
  490.         xitem = Get_After_Comma(i, countComa)
  491.             With lstmain.ListItems.Item(xitem + 1)
  492.                 If .SubItems(2) = "String" Then .SubItems(4) = """" & .SubItems(4) & """"
  493.                 Rich.Text = Rich.Text & vbTab & "Call .WriteProperty (" & """" & .SubItems(1) & """" & ", " & .SubItems(3) & ", " & .SubItems(4) & ")" & vbNewLine
  494.                 .SubItems(4) = Replace(.SubItems(4), """", "")
  495.             End With
  496.         Next
  497.         Rich.Text = Rich.Text & "   End With" & vbNewLine
  498.         Rich.Text = Rich.Text & "End Sub"
  499.     Case 3, 5 'Copy
  500.         cmdmain_Click 2
  501.         Clipboard.Clear
  502.         Clipboard.SetText Rich.Text
  503.     Case 4 'Exit
  504.         Unload Me
  505.         End
  506.     Case 6 ' Clears the listview:
  507.     If MsgBox("Are you sure you want to delete all entries in the List?", _
  508.     vbCritical + vbYesNo, App.Title) = vbNo _
  509.     Then Exit Sub
  510.     
  511.     lstmain.ListItems.Clear
  512.     listcount
  513.     checklst
  514.     
  515. End Select
  516. End Sub
  517.  
  518. Private Sub Combo1_KeyPress(KeyAscii As Integer)
  519. ComboKeyPress Combo1, KeyAscii
  520. End Sub
  521.  
  522.  
  523. Private Sub Combo1_LostFocus()
  524.     Combo1.SelLength = 0
  525. End Sub
  526.  
  527. Private Function countComa()
  528.    Dim i As Long
  529.    Dim r As Long
  530.    Dim LV As LV_ITEM
  531.    
  532.   'a string to build the msgbox text with
  533.    Dim b As String
  534.  
  535.   'iterate through each item, checking its item state
  536.    For i = 0 To lstmain.ListItems.Count
  537.       r = SendMessage(lstmain.hwnd, LVM_GETITEMSTATE, i, ByVal LVIS_STATEIMAGEMASK)
  538.      'when an item is checked, the LVM_GETITEMSTATE call
  539.      'returns 8192 (&H2000&).
  540.       If (r And &H2000&) Then
  541.          'it is checked, so pad the LV_ITEM string members
  542.          With LV
  543.             .cchTextMax = MAX_PATH
  544.             .pszText = Space$(MAX_PATH)
  545.          End With
  546.         'and retrieve the value (text) of the checked item
  547.          Call SendMessage(lstmain.hwnd, LVM_GETITEMTEXT, i, LV)
  548.          b = b & CStr(i) & ","
  549.       End If
  550.    Next
  551.    countComa = b
  552. End Function
  553.  
  554. Private Function FindLVCHKED()
  555. Dim CharCount As String
  556. Dim Char As String
  557. Char = ","
  558.     ' returns 5 but 6 if +1
  559.     CharCount = Occurs(countComa, Char) '+ 1
  560. If CharCount <= 0 Then
  561. CharCount = 0
  562. FindLVCHKED = "0"
  563. Else
  564. FindLVCHKED = CharCount
  565. End If
  566. End Function
  567.  
  568. Private Sub Command1_Click()
  569. EnhLitView_CheckAllItems lstmain
  570. listcount
  571. End Sub
  572.  
  573. Private Sub Command2_Click()
  574. EnhLitView_UnCheckAllItems lstmain
  575. listcount
  576. End Sub
  577.  
  578. Private Sub Command3_Click()
  579. EnhListView_InvertAllChecks lstmain
  580. listcount
  581. End Sub
  582.  
  583. Private Sub Command4_Click()
  584. cmdmain_Click (6)
  585. End Sub
  586.  
  587. Private Sub Form_Load()
  588. Dim list_item As ListItem
  589.  
  590.     Set X.list = lstmain
  591.     X.addcolumn "ID", "id", 700, True, False
  592.     X.addcolumn "Property Name", "pname", 1640, True, False
  593.     X.addcolumn "Type Var", "tvar", 1600, False, True
  594.     X.addcolumn "Container Var", "cvar", 1600, False, True
  595.     X.addcolumn "Default Value", "defvalue", 1600, False, False
  596.     lstmain.SmallIcons = imgSmall
  597.     
  598.     If Combo1.listcount = 0 Then LoadCombo Combo1
  599.     
  600.     ShowHeaderIcon 0, 0, True
  601.     
  602.     tHt.iItem = -1
  603.     ' set lvVSS to set nodes for project.
  604.     Call ListView_FullRowSelect(lstmain)
  605.     Call ListView_GridLines(lstmain)
  606.    
  607.    lstmain.Refresh
  608.    checklst
  609.    listcount
  610.    
  611.     Call SendMessage(lstmain.hwnd, _
  612.                     LVM_SETEXTENDEDLISTVIEWSTYLE, _
  613.                     LVS_EX_CHECKBOXES, ByVal True)
  614.  
  615.    Set TT = New CTooltip
  616.    TT.Style = TTBalloon
  617.    TT.Icon = TTIconInfo
  618.     lstmain.Refresh
  619.     
  620. End Sub
  621.  
  622. Private Sub Form_Unload(Cancel As Integer)
  623. If DocChanged = True Then
  624.     
  625.     Select Case MsgBox( _
  626.             "Do you wish to save your changes?", _
  627.             vbExclamation + vbYesNoCancel, "ActiveX Coder 3")
  628.     
  629.     Case vbYes
  630.         mnuFileS_Click
  631.     Case vbNo
  632.         Unload frmMain
  633.     Case vbCancel
  634.         Cancel = True
  635.     
  636.     End Select
  637.  
  638. End If
  639. End Sub
  640.  
  641. Private Sub lstmain_Click()
  642. listcount
  643. End Sub
  644.  
  645. Private Sub lstmain_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
  646.  
  647.    Dim i As Long
  648.    Static sOrder
  649.    
  650.    sOrder = Not sOrder
  651.    
  652.   'Use default sorting to sort the items in the list
  653.    lstmain.SortKey = ColumnHeader.index - 1
  654.    lstmain.SortOrder = Abs(sOrder)
  655.    lstmain.Sorted = True
  656.    
  657.   'clear the image from the headers not
  658.   'currently selected, and update the
  659.   'header clicked
  660.    For i = 0 To 4
  661.       
  662.      'if this is the index of the header clicked
  663.       If i = lstmain.SortKey Then
  664.       
  665.            'ShowHeaderIcon colNo, imgIndex, showFlag
  666.             ShowHeaderIcon lstmain.SortKey, _
  667.                            lstmain.SortOrder, _
  668.                            True
  669.                            
  670.       Else: ShowHeaderIcon i, 0, False
  671.       End If
  672.    
  673.    Next
  674.    
  675. End Sub
  676.  
  677. Private Sub lstmain_DblClick()
  678. Call mnuLstMainEdit_Click
  679. End Sub
  680.  
  681. Private Sub lstmain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  682.  
  683.       
  684.     tHt = ListView_HitTest(lstmain, X, Y)
  685.         
  686.     If Button <> 2 Then Exit Sub
  687.     
  688.     If tHt.iItem = -1 Then
  689.         mnuLstMainRR.Enabled = False
  690.         mnuLstMainEdit.Enabled = False
  691.         mnuLstMainDelR.Enabled = False
  692.     Else
  693.         mnuLstMainRR.Enabled = True
  694.         mnuLstMainEdit.Enabled = True
  695.         mnuLstMainDelR.Enabled = True
  696.         lstmain.ListItems(tHt.iItem + 1).Selected = True
  697.     End If
  698.     
  699.     PopupMenu mnuLstMain
  700. End Sub
  701.  
  702. Private Sub lstmain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  703.    On Error Resume Next
  704.    Dim lvhti As LVHITTESTINFO
  705.    Dim lItemIndex As Long
  706.    Dim lvs As ListItem
  707.    lvhti.pt.X = X / Screen.TwipsPerPixelX
  708.    lvhti.pt.Y = Y / Screen.TwipsPerPixelY
  709.    lItemIndex = SendMessage(lstmain.hwnd, LVM_HITTEST, 0, lvhti) + 1
  710.    
  711.    If m_lCurItemIndex <> lItemIndex Then
  712.       m_lCurItemIndex = lItemIndex
  713.       If m_lCurItemIndex = 0 Then   ' no item under the mouse pointer
  714.          TT.Destroy
  715.       Else
  716.       Set lvs = lstmain.ListItems(m_lCurItemIndex)
  717.          TT.Title = "Property Info "
  718.          TT.TipText = lstmain.ColumnHeaders.Item(2) & ": " & lvs.SubItems(1) _
  719.          & vbCrLf & lstmain.ColumnHeaders.Item(3) & ": " & lvs.SubItems(2) _
  720.          & vbCrLf & lstmain.ColumnHeaders.Item(4) & ": " & lvs.SubItems(3) _
  721.          & vbCrLf & lstmain.ColumnHeaders.Item(5) & ": " & lvs.SubItems(4)
  722.          TT.Create lstmain.hwnd
  723.       End If
  724.    End If
  725. End Sub
  726.  
  727. Private Sub lstmain_OLEDragDrop(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  728. 'On Error GoTo Err
  729. Dim LstIcon As Integer
  730. Dim the_array() As String
  731. Dim list_item As ListItem
  732. Dim file_name As String
  733. Dim fnum As Integer
  734. Dim whole_file As String
  735. Dim lines As Variant
  736. Dim one_line As Variant
  737. Dim num_rows As Long
  738. Dim num_cols As Long
  739. Dim r As Long
  740. Dim C As Long
  741.  
  742.     ' Load the file.
  743.     file_name = Data.Files(1)
  744.     fnum = FreeFile
  745.     Open file_name For Input As fnum
  746.     whole_file = Input$(LOF(fnum), #fnum)
  747.     Close fnum
  748.  
  749.     ' Break the file into lines.
  750.     lines = Split(whole_file, vbCrLf)
  751.  
  752.     ' Dimension the array.
  753.     num_rows = UBound(lines)
  754.     one_line = Split(lines(0), ",")
  755.     num_cols = UBound(one_line)
  756.     ReDim the_array(num_rows, num_cols)
  757.  
  758.     ' Copy the data into the array.
  759.     For r = 0 To num_rows
  760.         one_line = Split(lines(r), ",")
  761.         For C = 0 To num_cols
  762.             the_array(r, C) = one_line(C)
  763.         Next C
  764.     Next r
  765.     
  766.     ' Prove we have the data loaded.
  767. For i = 1 To r
  768.         If xx >= r Then xx = 0
  769. Dim cb As String
  770.     cb = the_array(xx, 2)
  771.  
  772. If cb = "Boolean" Then
  773. LstIcon = 3
  774. ElseIf cb = "Byte" Then
  775. LstIcon = 3
  776. ElseIf cb = "Currency" Then
  777. LstIcon = 3
  778. ElseIf cb = "Date" Then
  779. LstIcon = 3
  780. ElseIf cb = "Double" Then
  781. LstIcon = 3
  782. ElseIf cb = "Integer" Then
  783. LstIcon = 3
  784. ElseIf cb = "Long" Then
  785. LstIcon = 3
  786. ElseIf cb = "New" Then
  787. LstIcon = 3
  788. ElseIf cb = "OLE_CANCELBOOL" Then
  789. LstIcon = 3
  790. ElseIf cb = "OLE_COLOR" Then
  791. LstIcon = 3
  792. ElseIf cb = "OLE_HANDLE" Then
  793. LstIcon = 3
  794. ElseIf cb = "OLE_OPTEXCLUSIVE" Then
  795. LstIcon = 3
  796. ElseIf cb = "Single" Then
  797. LstIcon = 3
  798. ElseIf cb = "StdFont" Then
  799. LstIcon = 4
  800. ElseIf cb = "StdPicture" Then
  801. LstIcon = 4
  802. ElseIf cb = "String" Then
  803. LstIcon = 3
  804. ElseIf cb = "Variant" Then
  805. LstIcon = 3
  806. End If
  807.     Set list_item = lstmain.ListItems.Add(, , lstmain.ListItems.Count + 1)
  808.     list_item.SmallIcon = LstIcon
  809.     list_item.SubItems(1) = the_array(xx, 1)
  810.     list_item.SubItems(2) = the_array(xx, 2)
  811.     list_item.SubItems(3) = the_array(xx, 3)
  812.     list_item.SubItems(4) = the_array(xx, 4)
  813. xx = xx + 1
  814. Next i
  815.  
  816. listcount
  817. checklst
  818. DocChanged = True
  819.     Exit Sub
  820. Err:
  821.     MsgBox "The File could not be loaded", vbExclamation
  822. End Sub
  823.  
  824. Private Sub mnuEditAdd_Click()
  825. cmdmain_Click 0
  826. End Sub
  827.  
  828. Private Sub mnuEditCopy_Click()
  829. cmdmain_Click 3
  830. End Sub
  831.  
  832. Private Sub mnuEditGen_Click()
  833. cmdmain_Click 2
  834. End Sub
  835.  
  836. Private Sub mnuEditRemove_Click()
  837. cmdmain_Click 1
  838. End Sub
  839.  
  840. Private Sub mnuEditRemoveAll_Click()
  841. cmdmain_Click 6
  842. End Sub
  843.  
  844. Private Sub mnuFileExit_Click()
  845. Unload Me
  846. End Sub
  847.  
  848. Private Sub mnuFileImp_Click()
  849. LoadArray
  850. listcount
  851. checklst
  852. End Sub
  853.  
  854. Private Sub mnuFileLoad_Click()
  855. mnuFileNew_Click
  856. LoadArray
  857. listcount
  858. checklst
  859. End Sub
  860.  
  861. Private Sub mnuFileNew_Click()
  862. Dim Cancel As Integer
  863.  
  864. If DocChanged = False Then
  865.     DocChanged = False
  866.     lstmain.ListItems.Clear
  867.     Rich.Text = ""
  868.     listcount
  869.     checklst
  870.     ClearTxt
  871. Else
  872.     Select Case MsgBox("The file has changed." & vbCr & vbCr & _
  873.             "Do you wish to save your changes?", _
  874.             vbExclamation + vbYesNoCancel, "ActiveX Coder 3")
  875.     
  876.     Case vbYes
  877.         mnuFileS_Click
  878.     Case vbNo
  879.         DocChanged = False
  880.         lstmain.ListItems.Clear
  881.         Rich.Text = ""
  882.         listcount
  883.         checklst
  884.         ClearTxt
  885.     Case vbCancel
  886.         Cancel = True
  887.     
  888.     End Select
  889. End If
  890.  
  891. End Sub
  892.  
  893. Private Sub SaveNow()
  894. On Error Resume Next
  895. Rich.Text = ""
  896. For i = 1 To lstmain.ListItems.Count
  897. Rich.Text = Rich.Text & lstmain.ListItems.Item(i)
  898. Rich.Text = Rich.Text & "," & lstmain.ListItems.Item(i).SubItems(1)
  899. Rich.Text = Rich.Text & "," & lstmain.ListItems.Item(i).SubItems(2)
  900. Rich.Text = Rich.Text & "," & lstmain.ListItems.Item(i).SubItems(3)
  901. Rich.Text = Rich.Text & "," & lstmain.ListItems.Item(i).SubItems(4)
  902. If i = lstmain.ListItems.Count Then GoTo save:
  903. Rich.Text = Rich.Text & vbNewLine
  904. Next
  905.  
  906. save:
  907.  
  908. End Sub
  909.  
  910.  
  911. Private Sub mnuFileS_Click()
  912. Call SaveNow
  913. If docname = "" Then
  914.     mnuFileSS_Click
  915. Else
  916. Rich.SaveFile docname, rtfText
  917. DocChanged = False
  918. End If
  919.  
  920. End Sub
  921.  
  922. Private Sub mnuFileSS_Click()
  923. Call SaveNow
  924. Dim Cancel As Boolean
  925. On Error GoTo errorhandler
  926. Cancel = False
  927.  
  928. CDL1.DefaultExt = ".txt"
  929. CDL1.Filter = "Text Files (*.txt)|*.txt|RichText Files (*.rtf)|*.rtf|All Files (*.*)|*.*"
  930. CDL1.CancelError = True
  931. CDL1.flags = cdlOFNHideReadOnly Or cdlOFNOverwritePrompt
  932.  
  933. CDL1.ShowSave
  934.  
  935. If Not Cancel Then
  936.     If UCase(Right(CDL1.FileName, 3)) = "RTF" Then
  937.         Rich.SaveFile CDL1.FileName, rtfRTF
  938.     Else
  939.         Rich.SaveFile CDL1.FileName, rtfText
  940.     End If
  941.     Rich.FileName = CDL1.FileName
  942.     docname = CDL1.FileName
  943.     Me.Caption = App.Title & " " & docname
  944.     DocChanged = False
  945. End If
  946.  
  947. Exit Sub
  948.  
  949. errorhandler:
  950. If Err.Number = cdlCancel Then
  951.     Cancel = True
  952.     Resume Next
  953. End If
  954.  
  955. End Sub
  956.  
  957. Private Sub mnuHelpAbout_Click()
  958.  ShellAbout Me.hwnd, App.Title, "Coded by: Jovica Mizdrak" _
  959.         & vbNewLine & "E-mail: j3d_jovica@hotmail.com", ByVal 0&
  960. End Sub
  961.  
  962. Private Sub listcount()
  963. If lstmain.ListItems.Count >= 1 Then
  964. lbllstcount.Caption = FindLVCHKED & " of " & lstmain.ListItems.Count & " are selected"
  965. Else
  966. lbllstcount.Caption = "List is empty"
  967. End If
  968.  
  969. End Sub
  970.  
  971. Private Sub checklst()
  972.         If lstmain.ListItems.Count = 0 Then
  973.         cmdmain(5).Enabled = False
  974.         mnuEditGen.Enabled = False
  975.         mnuEditCopy.Enabled = False
  976.         cmdmain(1).Enabled = False
  977.         mnuEditRemove.Enabled = False
  978.         mnuEditRemoveAll.Enabled = False
  979.         Command4.Enabled = False
  980.         End If
  981.         
  982.         If Not lstmain.ListItems.Count = 0 Then
  983.         cmdmain(5).Enabled = True
  984.         mnuEditGen.Enabled = True
  985.         mnuEditCopy.Enabled = True
  986.         cmdmain(1).Enabled = True
  987.         mnuEditRemove.Enabled = True
  988.         mnuEditRemoveAll.Enabled = True
  989.         Command4.Enabled = True
  990.         End If
  991.         
  992.         If DocChanged = True Then
  993.         mnuFileS.Enabled = True
  994.         End If
  995.         
  996.         If DocChanged = False Then
  997.         mnuFileS.Enabled = False
  998.         End If
  999.         
  1000.         If lstmain.ListItems.Count = 0 Then
  1001.         mnuFileS.Enabled = False
  1002.         Else
  1003.         mnuFileS.Enabled = True
  1004.         End If
  1005.          
  1006. End Sub
  1007.  
  1008. Private Sub mnuLstMainDelR_Click()
  1009. cmdmain_Click 6
  1010. End Sub
  1011.  
  1012. Private Sub mnuLstMainEdit_Click()
  1013. On Error Resume Next
  1014. frmRow.open_dlg lstmain.SelectedItem.SubItems(1), _
  1015.                 lstmain.SelectedItem.SubItems(2), _
  1016.                 lstmain.SelectedItem.SubItems(3), _
  1017.                 lstmain.SelectedItem.SubItems(4)
  1018. End Sub
  1019.  
  1020. Private Sub mnuLstMainRR_Click()
  1021. cmdmain_Click 1
  1022. End Sub
  1023.  
  1024. Private Sub LoadArray()
  1025. On Error GoTo exits:
  1026. Dim LstIcon As Integer
  1027. Dim the_array() As String
  1028. Dim list_item As ListItem
  1029. Dim file_name As String
  1030. Dim fnum As Integer
  1031. Dim whole_file As String
  1032. Dim lines As Variant
  1033. Dim one_line As Variant
  1034. Dim num_rows As Long
  1035. Dim num_cols As Long
  1036. Dim r As Long
  1037. Dim C As Long
  1038.  
  1039. Dim Cancel As Boolean
  1040. On Error GoTo errorhandler
  1041. Cancel = False
  1042.  
  1043. CDL1.Filter = "Text Files (*.txt)|*.txt|RichText Files (*.rtf)|*.rtf|All Files|*.*"
  1044. CDL1.CancelError = True
  1045. CDL1.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
  1046. CDL1.ShowOpen
  1047.  
  1048. If Not Cancel Then
  1049.         file_name = CDL1.FileName
  1050.         docname = file_name
  1051.         Me.Caption = App.Title & " " & docname
  1052.         DocChanged = False
  1053. End If
  1054. GoTo loadl:
  1055. ' -------------------
  1056. errorhandler:
  1057. If Err.Number = cdlCancel Then
  1058.     Cancel = True
  1059.     Resume Next
  1060. End If
  1061.  
  1062. loadl:
  1063. On Error GoTo exits:
  1064.     ' Load the file.
  1065.     fnum = FreeFile
  1066.     Open file_name For Input As fnum
  1067.     whole_file = Input$(LOF(fnum), #fnum)
  1068.     Close fnum
  1069.  
  1070.     ' Break the file into lines.
  1071.     lines = Split(whole_file, vbCrLf)
  1072.  
  1073.     ' Dimension the array.
  1074.     num_rows = UBound(lines)
  1075.     one_line = Split(lines(0), ",")
  1076.     num_cols = UBound(one_line)
  1077.     ReDim the_array(num_rows, num_cols)
  1078.  
  1079.     ' Copy the data into the array.
  1080.     For r = 0 To num_rows
  1081.         one_line = Split(lines(r), ",")
  1082.         For C = 0 To num_cols
  1083.             the_array(r, C) = one_line(C)
  1084.         Next C
  1085.     Next r
  1086.     
  1087.     ' Prove we have the data loaded.
  1088.  
  1089. For i = 1 To r
  1090.     If xx >= r Then xx = 0
  1091. Dim cb As String
  1092.     cb = the_array(xx, 2)
  1093.  
  1094. If cb = "Boolean" Then
  1095. LstIcon = 3
  1096. ElseIf cb = "Byte" Then
  1097. LstIcon = 3
  1098. ElseIf cb = "Currency" Then
  1099. LstIcon = 3
  1100. ElseIf cb = "Date" Then
  1101. LstIcon = 3
  1102. ElseIf cb = "Double" Then
  1103. LstIcon = 3
  1104. ElseIf cb = "Integer" Then
  1105. LstIcon = 3
  1106. ElseIf cb = "Long" Then
  1107. LstIcon = 3
  1108. ElseIf cb = "New" Then
  1109. LstIcon = 3
  1110. ElseIf cb = "OLE_CANCELBOOL" Then
  1111. LstIcon = 3
  1112. ElseIf cb = "OLE_COLOR" Then
  1113. LstIcon = 3
  1114. ElseIf cb = "OLE_HANDLE" Then
  1115. LstIcon = 3
  1116. ElseIf cb = "OLE_OPTEXCLUSIVE" Then
  1117. LstIcon = 3
  1118. ElseIf cb = "Single" Then
  1119. LstIcon = 3
  1120. ElseIf cb = "StdFont" Then
  1121. LstIcon = 4
  1122. ElseIf cb = "StdPicture" Then
  1123. LstIcon = 4
  1124. ElseIf cb = "String" Then
  1125. LstIcon = 3
  1126. ElseIf cb = "Variant" Then
  1127. LstIcon = 3
  1128. End If
  1129.     Set list_item = lstmain.ListItems.Add(, , lstmain.ListItems.Count + 1)
  1130.     list_item.SmallIcon = LstIcon
  1131.     list_item.SubItems(1) = the_array(xx, 1)
  1132.     list_item.SubItems(2) = the_array(xx, 2)
  1133.     list_item.SubItems(3) = the_array(xx, 3)
  1134.     list_item.SubItems(4) = the_array(xx, 4)
  1135. xx = xx + 1
  1136. Next i
  1137.  
  1138. exits:
  1139. DocChanged = True
  1140. End Sub
  1141.  
  1142. Private Sub Rich_KeyUp(KeyCode As Integer, Shift As Integer)
  1143. 'setcolors
  1144. End Sub
  1145.  
  1146. Private Sub Rich_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1147. 'setcolors
  1148. End Sub
  1149.  
  1150. Private Sub Rich_Change()
  1151. 'setcolors
  1152. End Sub
  1153.